Lab 14 Homework
Yumna Moustafa
2021-03-04
Instructions
Answer the following questions and complete the exercises in RMarkdown. Please embed all of your code and push your final work to your repository. Your final lab report should be organized, clean, and run free from errors. Remember, you must remove the # for the included code chunks to run. Be sure to add your name to the author header above. For any included plots, make sure they are clearly labeled. You are free to use any plot type that you feel best communicates the results of your analysis.
Make sure to use the formatting conventions of RMarkdown to make your report neat and clean!
Load the libraries
library(qtl)
library(qtlcharts)
library(tidyverse)
library(ggmap)1. We have a satellite collars on a number of different individuals and want to be able to quickly look at all of their recent movements at once. Please load all the data files from us_individual_collar_data and use for loop to create plots for all different individuals of the path they move on longitude and latitude.
data_files <- list.files("data/us_individual_collar_data", full.names = TRUE)
for (i in 1:length(data_files)){
data0 <- as.data.frame(read_csv(data_files[i]))
print(
ggplot(data0, aes(x=long,y=lat))+
geom_path()+
geom_point()+
labs(title = data_files[i], x = "longitude", y = "latitude")
)
}## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
2. Please load all the data files from us_individual_collar_data and combine all data into one data frame. Create a summary to show what is the maximum and minimum of recorded data points on longitude and latitude.
data_list <- lapply(data_files, read_csv)## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )us_collar_data_all <- bind_rows(data_list)
us_collar_data_all %>%
summarise(max_lat=max(lat),
min_lat=min(lat),
max_long=max(long),
min_long=min(long))## # A tibble: 1 x 4
## max_lat min_lat max_long min_long
## <dbl> <dbl> <dbl> <dbl>
## 1 41.6 26.6 -106. -123.3. Use the range of the latitude and longitude from Q2 to build an appropriate bounding box for your map and load a map from stamen in a terrain style projection and display the map. Then, build a final map that overlays the recorded path from Q1.
lat <- c(26.6116 , 41.58802)
long <- c(-122.6017 , -106.3343 )
bbox <- make_bbox(long, lat, f = 0.5)
map <- get_map(bbox, maptype = "terrain", source = "stamen")## Map tiles by Stamen Design, under CC BY 3.0. Data by OpenStreetMap, under ODbL.ggmap(map)
for (i in 1:length(data_files)){
data0 <- as.data.frame(read_csv(data_files[i]))
print(
ggmap(map)+
geom_path(data = data0, aes(long,lat))+
geom_point(data = data0, aes(long,lat))+
labs(title = data_files[i], x = "longitude", y = "latitude")
)
}## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
## Warning: Missing column names filled in: 'X1' [1]##
## -- Column specification --------------------------------------------------------
## cols(
## X1 = col_double(),
## date = col_date(format = ""),
## collar = col_character(),
## time = col_datetime(format = ""),
## lat = col_double(),
## long = col_double()
## )
Load the Data
We will use the data from an experiment on hypertension in the mouse Sugiyama et al., Genomics 71:70-77, 2001
data(hyper)4. Create a summary of the hypertension data. How many individuals and phenotypes are included in this data set? How many gene markers and chromosomes are included in this data set? Please create a table to show the number of markers on each chromosome.
summary(hyper)## Backcross
##
## No. individuals: 250
##
## No. phenotypes: 2
## Percent phenotyped: 100 100
##
## No. chromosomes: 20
## Autosomes: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
## X chr: X
##
## Total markers: 174
## No. markers: 22 8 6 20 14 11 7 6 5 5 14 5 5 5 11 6 12 4 4 4
## Percent genotyped: 47.7
## Genotypes (%):
## Autosomes: BB:50.1 BA:49.9
## X chromosome: BY:53.0 AY:47.0There are 250 individuals, and 2 phenotypes in this dataset. There are 174 total markers and 20 chromosomes
5. Please make an interactive genetic map of markers for the hypertension data.
iplotMap(hyper)## Set screen size to height=700 x width=10006. Make a plot shows the pattern of missing genotype data in the hypertension dataset. Please reorder the recorded individuals according to their blood pressure phenotypes. Is there a specific pattern of missing genotype? Please explain it.
plot(hyper)
head(hyper$pheno)## bp sex
## 1 109.6 male
## 2 109.8 male
## 3 110.1 male
## 4 110.6 male
## 5 115.0 male
## 6 109.8 maleplotMissing(hyper, main="", reorder=1)
Most of the missing data is coming from individuals 50-200
7. Based on your answer from previous question, you probably noticed that there are gene markers without data. Please use the function drop.nullmarkers to remove markers that have no genotype data. After this, make a new summary to show the number of markers on each chromosome. How many gene markers were dropped? Where were the dropped markers located? Please use the data without nullmarkers for the following questions.
hyper_drop <- drop.nullmarkers(hyper)
summary(hyper_drop)## Backcross
##
## No. individuals: 250
##
## No. phenotypes: 2
## Percent phenotyped: 100 100
##
## No. chromosomes: 20
## Autosomes: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
## X chr: X
##
## Total markers: 173
## No. markers: 22 8 6 20 14 11 7 6 5 5 14 5 5 4 11 6 12 4 4 4
## Percent genotyped: 48
## Genotypes (%):
## Autosomes: BB:50.1 BA:49.9
## X chromosome: BY:53.0 AY:47.0Only one marker from chromosome 14 was dropped
8. Please conduct single-QTL analysis and create a table to give the maximum LOD score on each chromosome based on their blood pressure phenotypes. Which gene marker has the higiest LOD score? Which chromosome contains the gene marker that has the highest LOD score? Then, creates an interactive chart with LOD curves from a genome scan for all chromosomes.
hyper_drop <- calc.genoprob(hyper_drop)
singqtl <- scanone(hyper_drop, pheno.col=1)
singqtl %>%
arrange(desc(lod))## chr pos lod
## D4Mit164 4 29.5 8.0936611995
## D4Mit214 4 21.9 6.8496711335
## D4Mit237 4 17.5 6.5578757800
## D4Mit286 4 18.6 6.5092502945
## D4Mit178 4 30.6 6.3749215180
## D4Mit111 4 25.1 6.3078995597
## D4Mit288 4 28.4 6.1784364828
## D4Mit53 4 23.0 5.8422220345
## D4Mit89 4 23.0 5.8422220345
## D4Mit108 4 16.4 5.4854360206
## D4Mit41 4 14.2 5.3803971305
## D4Mit81 4 31.7 5.1375886310
## D4Mit80 4 31.7 5.1375886310
## D4Mit276 4 32.8 4.8875613687
## D4Mit152 4 33.9 4.7648501857
## D4Mit302 4 35.0 3.7286727716
## D1Mit334 1 49.2 3.5267044634
## D1Mit94 1 67.8 3.3629179514
## D1Mit132 1 43.7 3.3421871787
## D1Mit46 1 43.7 3.3421871507
## D1Mit102 1 75.4 3.2198347634
## D1Mit100 1 74.3 3.1758610981
## D1Mit7 1 41.5 3.1328781519
## D1Mit218 1 69.9 3.0963729397
## D1Mit159 1 82.0 3.0292173193
## D1Mit267 1 82.0 3.0292172820
## D1Mit14 1 82.0 3.0290986270
## D1Mit105 1 82.0 3.0290985093
## D1Mit19 1 37.2 2.9441481443
## D4Mit175 4 47.0 2.7395652003
## D4Mit16 4 56.8 2.4330012251
## D4Mit14 4 74.3 2.1736121580
## D1Mit26 1 64.5 2.1623610729
## D4Mit149 4 0.0 2.0619239320
## D1Mit305 1 54.6 2.0065693641
## D6Mit188 6 21.9 1.8211658159
## D6Mit8 6 25.1 1.7993072464
## D15Mit152 15 17.5 1.7053688802
## D15Mit206 15 17.5 1.7053688374
## D1Mit156 1 32.8 1.6943724765
## D1Mit178 1 35.0 1.6519940836
## D5Mit31 5 66.7 1.5447695317
## D1Mit15 1 86.3 1.5124874334
## D2Mit62 2 54.6 1.4451669255
## D5Mit99 5 73.2 1.4008517779
## D15Mit22 15 16.4 1.3672909546
## D15Mit56 15 16.4 1.3672909477
## D5Mit101 5 74.3 1.3523879809
## D5Mit169 5 82.0 1.3352994035
## D1Mit456 1 94.0 1.3031277002
## D5Mit409 5 77.6 1.2961121884
## D15Mit111 15 13.1 1.2863047439
## D2Mit14 2 49.2 1.2477059750
## D2Mit280 2 66.7 1.1551254989
## D6Mit36 6 40.4 1.1322955298
## D15Mit11 15 5.5 1.0675142338
## D15Mit175 15 5.5 1.0675142315
## D15Mit156 15 29.5 1.0457533483
## D6Mit295 6 63.4 0.9842684697
## D15Mit79 15 63.4 0.9666623557
## D6Mit213 6 29.5 0.9416037768
## DXMit130 X 43.7 0.9274964233
## D6Mit135 6 51.4 0.8835488689
## D6Mit273 6 9.8 0.8353447217
## D2Mit241 2 29.5 0.8286552497
## D6Mit59 6 56.8 0.8142005652
## D19Mit59 19 0.0 0.7917868438
## D8Mit271 8 59.0 0.7907409143
## D3Mit11 3 37.2 0.7807048362
## D9Mit18 9 68.9 0.7502459166
## D15Mit53 15 7.7 0.7459694196
## DXMit16 X 29.5 0.7128611939
## D6Mit15 6 66.7 0.6595297122
## D6Mit201 6 65.6 0.6410131121
## D11Mit35 11 43.7 0.6259820641
## D15Mit108 15 55.7 0.6078228353
## D3Mit6 3 17.5 0.5885098768
## D2Mit82 2 17.5 0.5368659034
## D18Mit17 18 14.2 0.5057623851
## DXMit22 X 20.8 0.4472058101
## D12Mit37 12 1.1 0.4286562092
## D1Mit296 1 3.3 0.4117448071
## D5Mit213 5 60.1 0.4021080017
## D7Mit297 7 26.2 0.4000641331
## D11Mit310 11 25.1 0.4000344400
## D1Mit123 1 19.7 0.3995970550
## D11Mit20 11 19.7 0.3920578178
## D8Mit156 8 75.4 0.3871432575
## D19Mit137 19 55.7 0.3801939921
## D5Mit193 5 0.0 0.3728645888
## D16Mit70 16 51.4 0.3701823277
## D16Mit106 16 51.4 0.3701823244
## D5Mit55 5 18.6 0.3380438352
## D19Mit53 19 32.8 0.3202410984
## D13Mit78 13 59.0 0.3127863765
## D11Mit110 11 17.5 0.3004352659
## D11Mit136 11 17.5 0.3004352512
## D1Mit155 1 115.8 0.2659435308
## D5Mit188 5 51.4 0.2654893375
## D10Mit214 10 15.3 0.2466849472
## D16Mit4 16 25.1 0.2435883302
## D11Mit163 11 13.1 0.2401204010
## D2Mit359 2 7.7 0.2247897209
## D5Mit61 5 5.5 0.2246562321
## D16Mit171 16 31.7 0.2198068608
## D10Mit166 10 2.2 0.2143123352
## D17Mit46 17 3.3 0.2066625662
## D17Mit131 17 3.3 0.2066625525
## D11Mit67 11 60.1 0.1964948082
## D13Mit148 13 40.4 0.1844976670
## D9Mit24 9 56.8 0.1800599409
## D19Mit40 19 17.5 0.1721772554
## D11Mit74 11 2.2 0.1716721453
## D3Mit14 3 44.8 0.1651759629
## D5Mit13 5 15.3 0.1630030540
## D11Mit82 11 10.9 0.1617231382
## D17Mit143 17 1.1 0.1557464648
## D17Mit164 17 1.1 0.1557464620
## D17Mit57 17 1.1 0.1557464377
## D11Mit2 11 4.4 0.1553722304
## D11Mit78 11 4.4 0.1553721963
## D7Mit30 7 28.4 0.1540588132
## D16Mit5 16 32.8 0.1418847041
## D7Mit306 7 1.1 0.1369746934
## D17Mit221 17 50.3 0.1302639649
## D18Mit67 18 2.2 0.1187825317
## D6Mit86 6 0.0 0.1172057408
## D7Mit25 7 13.1 0.1149397404
## D5Mit148 5 14.2 0.1139450913
## D9Mit297 9 12.0 0.1098126972
## D7Nds4 7 55.6 0.1093732137
## D14Mit7 14 52.5 0.1060170996
## D17Mit113 17 2.2 0.1024779096
## D13Mit16 13 5.7 0.0910047160
## D3Mit44 3 57.9 0.0899287390
## D10Mit297 10 75.4 0.0886546315
## D9Mit8 9 40.4 0.0882056000
## D14Mit14 14 16.4 0.0854485049
## D11Mit80 11 8.7 0.0699343995
## D11Mit79 11 8.7 0.0699343963
## D5Mit387 5 10.9 0.0649209336
## D8Mit3 8 6.6 0.0574090158
## D10Mit14 10 69.9 0.0507749899
## D2Mit266 2 98.4 0.0503093973
## D5Mit312 5 32.8 0.0474201810
## D18Mit4 18 37.2 0.0408141197
## D3Mit164 3 2.2 0.0370327430
## D14Mit37 14 36.1 0.0356625059
## D13Mit59 13 7.7 0.0327909578
## D16Mit32 16 0.0 0.0284895729
## D9Mit27 9 24.0 0.0278178870
## D17Mit53 17 33.9 0.0270201207
## D17Mit45 17 5.5 0.0262508589
## D2Mit229 2 85.2 0.0259369317
## D17Mit23 17 6.6 0.0255827405
## D13Mit91 13 16.4 0.0253706523
## D14Mit266 14 67.8 0.0242861774
## D8Mit45 8 40.4 0.0208415111
## D7Mit71 7 53.6 0.0190184791
## D17Mit11 17 10.9 0.0181788482
## D12Mit20 12 56.8 0.0136085794
## D7Mit37 7 37.2 0.0127470023
## D3Mit19 3 66.7 0.0122171169
## D18Mit50 18 26.2 0.0097073614
## D17Mit10 17 19.7 0.0059936347
## D12Mit118 12 40.4 0.0044248100
## D8Mit292 8 19.7 0.0035117015
## D10Mit11 10 50.3 0.0034444127
## D11Mit48 11 80.9 0.0033157554
## D12Mit34 12 23.0 0.0025417998
## DXMit55 X 1.1 0.0015569926
## D8Mit25 8 33.9 0.0007018864
## D12Mit110 12 16.4 0.0003539764Chromosome 4
iplotScanone(singqtl)The D4Mit164 marker on chromosome 4 has the highest LOD score
9. Based on your genome scan results, create a table which only includes those chromosomes with LOD > 1. Creates an interactive chart with LOD curves linked to estimated QTL effects for only those chromosomes with LOD > 1. Find the gene maker with the highest LOD score and describe how does the genetype of this marker influence the individual’s phenotype.
summary(singqtl, threshold=1) %>%
arrange(desc(lod))## chr pos lod
## D4Mit164 4 29.5 8.09
## D1Mit334 1 49.2 3.53
## D6Mit188 6 21.9 1.82
## D15Mit152 15 17.5 1.71
## D5Mit31 5 66.7 1.54
## D2Mit62 2 54.6 1.45iplotScanone(singqtl,hyper_drop, chr=c(1,2,4,5,6,15))The D4Mit164 marker on chromosome 4 has the highest LOD score. Having this marker means you are more likely to have a higher blood pressure
10. Please save your interactive chart from Q9 as a html file hyper_iplotScanone.html and make sure your upload it to your github repository with your lab14 homework as well.
savedplot <- iplotScanone(singqtl,hyper_drop, chr=c(1,2,4,5,6,15))
htmlwidgets::saveWidget(savedplot, file="hyper_iplotScanone.html")Push your final code to GitHub!
Please be sure that you check the keep md file in the knit preferences.